home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / oobr / eif-calls.el < prev    next >
Encoding:
Text File  |  1995-08-30  |  20.7 KB  |  569 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         eif-calls.el
  4. ;; SUMMARY:      Produce first level static call tree for Eiffel class.
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     oop, tools
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;; ORG:          Motorola Inc.
  10. ;;
  11. ;; ORIG-DATE:     7-Dec-89 at 19:32:47
  12. ;; LAST-MOD:     30-Aug-95 at 15:22:33 by Bob Weiner
  13. ;;
  14. ;; Copyright (C) 1989-1995  Free Software Foundation, Inc.
  15. ;; See the file BR-COPY for license information.
  16. ;;
  17. ;; This file is part of the OO-Browser.
  18. ;;
  19. ;; DESCRIPTION:  
  20. ;;
  21. ;;   The default commands, 'eif-store-class-info' and 'eif-insert-class-info'
  22. ;;     work in tandem to display the parents, attributes and routines with
  23. ;;     routine call summaries for a class.
  24. ;;   The command {M-x eif-info-use-short}, will instead cause the above
  25. ;;     commands to run the Eiffel 'short' command on a class, thereby
  26. ;;     displaying its specification.
  27. ;;   The command {M-x eif-info-use-flat}, will instead cause the above
  28. ;;     commands to run the Eiffel 'flat' command on a class, thereby
  29. ;;     displaying its complete feature set.
  30. ;;   Call {M-x eif-info-use-calls} to reset these commands to their default.
  31. ;;
  32. ;; DESCRIP-END.
  33.  
  34. ;;; ************************************************************************
  35. ;;; Other required Elisp libraries
  36. ;;; ************************************************************************
  37.  
  38. (require 'br-eif)
  39.  
  40. ;;; ************************************************************************
  41. ;;; Public functions
  42. ;;; ************************************************************************
  43.  
  44. (defun eif-info-use-calls ()
  45.   "Setup to display call trees and other class summary info."
  46.   (interactive)
  47.   (fset 'eif-store-class-info  'eif-store-class-info-calls)
  48.   (fset 'eif-insert-class-info 'eif-insert-class-info-calls))
  49. (eif-info-use-calls)
  50.  
  51. (defun eif-info-use-flat ()
  52.   "Setup to display the Eiffel 'flat' output for classes."
  53.   (interactive)
  54.   (fset 'eif-store-class-info  'eif-store-class-info-flat)
  55.   (fset 'eif-insert-class-info 'eif-insert-class-info-flat))
  56.  
  57. (defun eif-info-use-short ()
  58.   "Setup to display the Eiffel 'short' output for classes."
  59.   (interactive)
  60.   (fset 'eif-store-class-info  'eif-store-class-info-short)
  61.   (fset 'eif-insert-class-info 'eif-insert-class-info-short))
  62.  
  63. (defun eif-show-class-info (&optional class-name)
  64.   "Displays class specific information summary in other window.
  65. This summary includes listings of textually included attributes, routines,
  66. and routine calls from an Eiffel class.  Use optional CLASS-NAME for class
  67. text or extract from the current buffer."
  68.   (interactive (list (br-complete-class-name
  69.               nil
  70.               (let ((cn (car (eif-get-class-name-from-source))))
  71.             (if cn (concat "Class name: (default " cn ") "))))))
  72.   (let ((class-file-name))
  73.     (if (not (br-class-in-table-p class-name))
  74.     (if (setq class-file-name buffer-file-name)
  75.         (setq class-name (car (eif-get-class-name-from-source)))
  76.       (error "No class specified.")))
  77.     (if (null class-name)
  78.     (error "No class specified.")
  79.       (message "Building '%s' class info..." class-name)
  80.       (sit-for 2)
  81.       (eif-store-class-info class-name)
  82.       (message "Building '%s' class info...Done" class-name)
  83.       (br-eval-in-other-window "*Class Info*"
  84.                    '(eif-insert-class-info class-file-name)))))
  85.  
  86. ;;; ************************************************************************
  87. ;;; Internal functions
  88. ;;; ************************************************************************
  89.  
  90. (defun eif-get-class-name-from-source ()
  91.   "Return indication of closest class definition preceding point or nil.
  92. If non-nil, value is a cons cell of (class-name . deferred-class-p)."
  93.   (save-excursion
  94.     (if (or (re-search-backward eif-class-def-regexp nil t)
  95.         (re-search-forward eif-class-def-regexp nil t))
  96.     (cons (eif-set-case (buffer-substring (match-beginning 2)
  97.                           (match-end 2)))
  98.           (match-end 1)))))
  99.  
  100. (defun eif-insert-class-info-calls (&optional src-file-name)
  101.   "Inserts textually included attributes, routines, and routine calls from 'eif-last-class-name'.
  102. Uses optional SRC-FILE-NAME for lookups or class name from 'eif-last-class-name'."
  103.   (interactive)
  104.   (if (and eif-last-class-name eif-attributes-and-routines)
  105.       nil
  106.     (error (concat "Call 'eif-store-class-info' first."
  107.            (let ((key (car (where-is-internal 'eif-store-class-info))))
  108.              (and key (concat "  It is bound to {" key "}."))))))
  109.   (let ((in-lookup-table 
  110.       (if src-file-name
  111.           nil
  112.         (br-class-in-table-p eif-last-class-name))))
  113.     (if (not (or in-lookup-table src-file-name))
  114.     nil
  115.       (insert eif-last-class-name)
  116.       (center-line)
  117.       (insert "\n")
  118.       (insert "Parents:\n")
  119.       (let ((parents (if in-lookup-table
  120.              (br-get-parents eif-last-class-name)
  121.                (eif-get-parents-from-source src-file-name))))
  122.     (if parents
  123.         (mapcar (function (lambda (par) (insert "   " par "\n")))
  124.             parents)
  125.       (insert "   <None>\n"))
  126.     (let ((attribs (car eif-attributes-and-routines))
  127.           (routines (cdr eif-attributes-and-routines)))
  128.       (if parents
  129.           (insert "\nNon-Inherited Attributes:\n")
  130.         (insert "\nAttributes:\n"))
  131.       (if attribs
  132.           (mapcar (function (lambda(attr) (insert "   " attr "\n")))
  133.               attribs)
  134.         (insert "   <None>\n"))
  135.       (if parents
  136.           (insert
  137.            "\nNon-Inherited Routines with Apparent Routine Calls:\n")
  138.         (insert "\nRoutines with Apparent Routine Calls:\n"))
  139.       (if routines
  140.           (mapcar (function
  141.             (lambda(cns)
  142.               (insert "   " (car cns) "\n")
  143.               (mapcar (function
  144.                     (lambda (call)
  145.                      (insert "      " call "\n")))
  146.                   (cdr cns))))
  147.               routines)
  148.         (insert "   <None>\n"))
  149.       ))
  150.       (set-buffer-modified-p nil))))
  151.  
  152. (defun eif-store-class-info-calls (class-name)
  153.   "Generates cons of textually included attributes and routines (including routine calls) from CLASS-NAME.
  154. It stores this cons in the global 'eif-attributes-and-routines'."
  155.   (interactive (list (br-complete-class-name)))
  156.   (setq eif-last-class-name (downcase class-name))
  157.   (let ((in-lookup-table (br-class-path eif-last-class-name)))
  158.     (if (not (or in-lookup-table buffer-file-name))
  159.     nil
  160.       (setq eif-attributes-and-routines
  161.         (eif-get-features-from-source
  162.           (if in-lookup-table
  163.           (br-class-path eif-last-class-name)
  164.         buffer-file-name))))))
  165.  
  166. (defun eif-insert-class-info-short ()
  167.   (interactive)
  168.   (insert-file-contents eif-tmp-info-file)
  169.   (shell-command (concat "rm -f " eif-tmp-info-file))
  170.   (message ""))
  171.  
  172. (defun eif-store-class-info-short (class-name)
  173.   (interactive (list (br-complete-class-name)))
  174.   (shell-command (concat "short -b 3 -p "
  175.              (br-class-path (br-find-class-name))
  176.              "> " eif-tmp-info-file)))
  177.  
  178. (defun eif-insert-class-info-flat ()
  179.   (interactive)
  180.   (insert-file-contents eif-tmp-info-file)
  181.   (shell-command (concat "rm -f " eif-tmp-info-file))
  182.   (message ""))
  183.  
  184. (defun eif-store-class-info-flat (class-name)
  185.   (interactive (list (br-complete-class-name)))
  186.   (shell-command (concat "flat -b 3 "
  187.              (br-class-path (br-find-class-name))
  188.              "> " eif-tmp-info-file)))
  189.  
  190. (defun eif-class-name-from-file-name (file-name)
  191.   (string-match "^.*/\\([a-z0-9_]+\\)\\.e$" file-name)
  192.   (if (match-beginning 1)
  193.       (substring file-name (match-beginning 1) (match-end 1))))
  194.  
  195. (defun eif-eval-in-other-window (buffer form)
  196.   "Clear out BUFFER and display result of FORM evaluation in viewer window.
  197. Then return to previous window.  BUFFER may be a buffer name."
  198.   (interactive)
  199.   (let ((wind (selected-window)))
  200.     (pop-to-buffer (get-buffer-create buffer))
  201.     (let (buffer-read-only)
  202.       (erase-buffer)
  203.       (eval form))
  204.     (goto-char (point-min))
  205.     (setq buffer-read-only t)
  206.     (select-window wind)))
  207.  
  208. (defun eif-get-attribute-definition-regexp (identifier-regexp)
  209.   "Return regexp to match to IDENTIFIER-REGEXP definition.
  210. Matching attribute name is grouping 'eif-feature-name-grpn'."
  211.   (concat eif-modifier-regexp
  212.       "\\(" identifier-regexp "\\)[ \t]*:[ \t]*"
  213.       eif-type "\\([ \t]+is[ \t]+.+\\)?[ \t]*;?[ \t]*\\(--.*\\)?$"))
  214.  
  215. (defun eif-get-features-from-source (filename &optional form)
  216.   "Returns cons of attribute def list and routine def list from Eiffel class FILENAME.
  217. Optional FORM is a Lisp form to be evaluated instead of the default feature
  218. extraction.  Assumes file existence has already been checked.  The cdr of
  219. each element of each item in routine def list is a best guess list of
  220. subroutines invoked by the routine."
  221.   (let* ((no-kill (get-file-buffer filename))
  222.      (tmp-buf (set-buffer (get-buffer-create "*tmp*")))
  223.     features orig-buf)
  224.     (setq buffer-read-only nil)
  225.     (erase-buffer)
  226.     (if no-kill
  227.     (set-buffer no-kill)
  228.       (setq orig-buf (funcall br-find-file-noselect-function filename))
  229.       (set-buffer orig-buf))
  230.     (copy-to-buffer tmp-buf (point-min) (point-max))
  231.     (set-buffer tmp-buf)
  232.     (goto-char (point-min))
  233.     (while (re-search-forward "^\\([^\"\n]*\\)--.*" nil t)
  234.       (replace-match "\\1" t nil))
  235.     (goto-char (point-min))
  236.     (if (not (re-search-forward "^feature[ \t]*$" nil t))
  237.     nil
  238.       (setq features
  239.         (if form
  240.         (eval form)
  241.           (eif-parse-features)))
  242.       (erase-buffer) ; tmp-buf
  243.       (or no-kill (kill-buffer orig-buf))
  244.       )
  245.     features))
  246.  
  247. (defun eif-in-comment-p ()
  248.   "Return nil unless point is within an Eiffel comment."
  249.   (save-excursion
  250.     (let ((end (point)))
  251.       (beginning-of-line)
  252.       (search-forward "--" end t))))
  253.  
  254. (defun eif-to-attribute (&optional identifier)
  255.   "Move point to attribute matching optional IDENTIFIER or next attribute def in buffer.
  256. Leave point at beginning of line where feature is defined.
  257. Return name of attribute matched or nil.  Ignore obsolete attributes."
  258.   (let ((pat (if identifier
  259.          (eif-attribute-to-regexp identifier)
  260.            eif-attribute-regexp))
  261.     (start)
  262.     (found)
  263.     (keyword)
  264.     (non-attrib-keyword "local\\|require\\|ensure\\|invariant"))
  265.     (while (and (re-search-forward pat nil t)
  266.         (setq found (buffer-substring 
  267.                  (match-beginning eif-feature-name-grpn)
  268.                  (match-end eif-feature-name-grpn))
  269.               start (match-beginning 0))
  270.         ;; Continue loop if in a comment or a local declaration.
  271.         (or (if (eif-in-comment-p)
  272.             (progn (setq found nil) t))
  273.             (save-excursion
  274.               (while (and (setq keyword
  275.                     (re-search-backward
  276.                      (concat
  277.                       "\\(^\\|[ \t]+\\)\\("
  278.                       "end\\|feature\\|"
  279.                       non-attrib-keyword
  280.                       "\\)[\; \t\n]")
  281.                      nil t))
  282.                   (eif-in-comment-p)))
  283.               (if (and keyword
  284.                    (setq keyword
  285.                      (buffer-substring
  286.                       (match-beginning 2)
  287.                       (match-end 2)))
  288.                    (equal 0 (string-match non-attrib-keyword
  289.                               keyword)))
  290.               (progn (setq found nil) t))))))
  291.     (if start (goto-char start))
  292.     found))
  293.  
  294. (defun eif-parse-attributes ()
  295.   "Returns list of attributes defined in current buffer.
  296. Assumes point is at the start of buffer."
  297.   (let (attribs attrib lattrib reserved)
  298.     ;; For each attribute definition
  299.     (while (and (eif-to-attribute)
  300.         (looking-at eif-attribute-regexp))
  301.       (setq attrib (buffer-substring
  302.              (match-beginning eif-feature-name-grpn)
  303.              (match-end eif-feature-name-grpn))
  304.         lattrib (downcase attrib))
  305.       (goto-char (match-end 0))
  306.       (if (or (> (length lattrib) 9)
  307.           (< (length lattrib) 2))
  308.       nil
  309.     (setq reserved eif-reserved-words)
  310.     ;; Ensure that each attrib is not a reserved word
  311.     (while (if (string-equal lattrib (car reserved))
  312.            (setq attrib nil)
  313.          (string-lessp (car reserved) lattrib))
  314.       (setq reserved (cdr reserved))))
  315.       (if attrib (br-set-cons attribs attrib)))
  316.     (setq attribs (nreverse attribs))))
  317.  
  318. (defun eif-parse-features (&optional skip-calls)
  319.   "Returns cons of attribute def list and routine def list from current buffer.
  320. The cdr of each item in routine def list is a best guess list of routine calls
  321. invoked by the routine, unless optional SKIP-CALLS is non-nil, in which case
  322. each item is just the routine name."
  323.   (let ((routines) attribs external routine calls non-ids reserved type)
  324.     ;; Get attribute definitions
  325.     ;; and add attributes to list of names not to consider routine invocations.
  326.     (setq attribs (eif-parse-attributes)
  327.       non-ids (append attribs eif-reserved-words)
  328.       attribs (mapcar (function (lambda (attribute)
  329.                       (concat "= " attribute)))
  330.               attribs))
  331.     (goto-char (point-min))
  332.     ;; For each routine definition
  333.     (while (re-search-forward eif-routine-regexp nil t)
  334.       (setq routine (buffer-substring (match-beginning eif-feature-name-grpn)
  335.                       (match-end eif-feature-name-grpn))
  336.         external (if (match-beginning eif-modifier-grpn)
  337.              (string-match "external"
  338.                        (buffer-substring
  339.                     (match-beginning eif-modifier-grpn)
  340.                     (match-end eif-modifier-grpn))))
  341.         reserved non-ids)
  342.       (if (match-beginning eif-feature-args-grpn)
  343.       ;; Routine takes a list of arguments.
  344.       ;; Add ids matched to list of names not to consider routine
  345.       ;; invocations.
  346.       (setq reserved
  347.         (append (eif-parse-params
  348.              (match-beginning eif-feature-args-grpn)
  349.              (match-end eif-feature-args-grpn))
  350.             reserved)))
  351.       (cond (external
  352.          (setq routine (concat "/ " routine)))
  353.         ((re-search-forward
  354.           "^[ \t]*\\(do\\|once\\|deferred\\)[ \t\n]+" nil t)
  355.          (setq type (buffer-substring (match-beginning 1) (match-end 1)))
  356.          (cond ((string-equal type "do")
  357.             (setq routine (concat "- " routine)))
  358.            ((string-equal type "once")
  359.             (setq routine (concat "1 " routine)))
  360.            (t ;; deferred type
  361.             (setq routine (concat "> " routine))))
  362.          (if skip-calls
  363.          (setq routines (cons routine routines))
  364.            (setq calls (nreverse (eif-parse-ids reserved))
  365.              routines (cons (cons routine calls) routines))))))
  366.     (setq routines (nreverse routines))
  367.     (cons attribs routines)))
  368.     
  369. (defun eif-parse-ids (&optional non-ids)
  370.   "Ignores list of NON-IDS and returns list of Eiffel identifiers through the end of the current routine definition."
  371.   (let (call calls lcall call-list non-id-list same start valid-call)
  372.     (while (and (setq start (eif-try-for-routine-call))
  373.         ;; Ignore assignable entities
  374.         (cond ((stringp start)
  375.                (setq non-ids (cons (downcase start) non-ids)))
  376.               ;; Ignore reserved word expressions that look like
  377.               ;; routine calls with arguments
  378.               ((and (setq call
  379.                   (downcase
  380.                     (buffer-substring start (match-end 0))))
  381.                 (looking-at "[ \t]*\(")
  382.                 (br-member call non-ids)))
  383.               ;; Skip past rest of this routine invocation
  384.               ((progn
  385.              (while (or (progn (setq valid-call t same (point))
  386.                        (and (setq call
  387.                               (eif-skip-past-arg-list)
  388.                               valid-call
  389.                               (or (null call)
  390.                               (= call 0)))
  391.                         (looking-at "\\.")
  392.                         (progn
  393.                           (skip-chars-forward ".")
  394.                           (if (setq valid-call
  395.                                 (looking-at
  396.                                  eif-identifier))
  397.                               (goto-char
  398.                                (match-end 0)))))
  399.                        (> (point) same))
  400.                     (if (and valid-call (looking-at "\\."))
  401.                     (progn (skip-chars-forward ".")
  402.                            (if (setq valid-call
  403.                              (looking-at
  404.                                eif-identifier))
  405.                            (goto-char
  406.                             (match-end 0)))))))
  407.              (if (and valid-call
  408.                   (/= start (point)))
  409.                  (progn (setq call (buffer-substring start (point))
  410.                       lcall (downcase call))
  411.                     ;; If at end of 'do' part of routine
  412.                     ;; definition...
  413.                     (if (or (string-equal lcall "ensure")
  414.                         (and (string-equal lcall "end")
  415.                          (looking-at
  416.                            "[ \t]*[;]?[ \t]*[\n][ \t]*[\n]")))
  417.                     (setq valid-call nil)
  418.                       (if call (br-set-cons calls call))
  419.                       )
  420.                     valid-call)
  421.                nil))))))
  422.     (while calls
  423.       (setq call (car calls)
  424.         calls (cdr calls)
  425.         lcall (downcase call)
  426.         non-id-list
  427.         (or non-ids eif-reserved-words))
  428.       (if (br-member lcall non-id-list)
  429.       (setq call nil))
  430.       (if call (setq call-list (append call-list (list call)))))
  431.     call-list))
  432.  
  433. (defun eif-parse-params (start end)
  434.   "Returns list of Eiffel formal parameters between START and END, in reverse order."
  435.   (narrow-to-region start end)
  436.   (goto-char (point-min))
  437.   (let (params)
  438.     (while (re-search-forward eif-identifier nil t)
  439.       (setq params (cons (buffer-substring
  440.               (match-beginning 0) (match-end 0)) params))
  441.       (if (looking-at "[ \t]*:")
  442.       (progn (goto-char (match-end 0))
  443.          (re-search-forward eif-type nil t)))
  444.       )
  445.     (widen)
  446.     params))
  447.  
  448. (defun eif-skip-past-arg-list ()
  449.   "Skips path arg list delimited by parenthesis.
  450. Leaves point after closing parenthesis.  Returns number of unclosed parens
  451. iff point moves, otherwise nil." 
  452.   (let ((depth 0))
  453.     (if (not (looking-at "[ \t]*\("))
  454.     nil
  455.       (setq depth (1+ depth))
  456.       (goto-char (match-end 0))
  457.       (while (> depth 0)
  458.     (skip-chars-forward "^()\"'")
  459.     (cond ((= ?\" (following-char))
  460.            (progn (forward-char 1)
  461.               (skip-chars-forward "^\"")))
  462.           ((= ?' (following-char))
  463.            (progn (forward-char 1)
  464.               (skip-chars-forward "^'")))
  465.           ((setq depth (if (= ?\( (following-char))
  466.                   (1+ depth)
  467.                 (1- depth)))))
  468.     (and (not (eobp)) (forward-char 1)))
  469.       depth)))
  470.  
  471. (defun eif-try-for-routine-call ()
  472.   "Matches to best guess of next routine call.
  473. Returns character position of start of valid match, nil when no match,
  474. identifier string when an assignable entity, i.e. matches to a non-routine."
  475.   (if (re-search-forward (concat eif-identifier "\\([ \t\n]*:=\\)?") nil t)
  476.       (if (match-beginning 2)
  477.       (buffer-substring (match-beginning 1) (match-end 1))
  478.     (match-beginning 0))))
  479.  
  480. ;;; ************************************************************************
  481. ;;; Internal variables
  482. ;;; ************************************************************************
  483.  
  484. (defvar eif-reserved-words
  485.   '("!!" "alias" "and" "as" "bits" "boolean" "character" "check" "class" "clone" "create"
  486.     "creation"
  487.     "current" "debug" "deferred" "define" "div" "do" "double" "else" "elseif"
  488.     "end" "ensure" "expanded" "export" "external" "false" "feature" "forget"
  489.     "from" "if" "implies" "indexing" "infix" "inherit" "inspect" "integer"
  490.     "invariant" "is" "language" "like" "local" "loop" "mod" "name" "nochange"
  491.     "not" "obsolete" "old" "once" "or" "prefix" "real" "redefine" "rename"
  492.     "repeat" "require" "rescue" "result" "retry" "select" "then" "true"
  493.     "undefine" "unique" "until" "variant" "void" "when" "xor")
  494.   "Lexicographically ordered list of reserved words in Eiffel version 2.2.
  495. Longest one is 9 characters.
  496. Minor support for Eiffel 3 has now been added.")
  497.  
  498. ;; Must handle types of these forms:
  499. ;;   like LIST [INTEGER]
  500. ;;   VECTOR [INTEGER , INTEGER]
  501. ;;   LIST [ LIST[INTEGER]]
  502. ;; yet must ignore the 'is' in:
  503. ;;   var: INTEGER is 0
  504. (defconst eif-type
  505.   "\\(like[ \t]+\\)?[a-zA-Z][a-zA-Z_0-9]*\\([ \t]*\\[.+\\]\\)?"
  506.   "Regexp to match Eiffel entity and return value type expressions.")
  507.  
  508. (defconst eif-modifier-regexp
  509.   "^[ \t]*\\(frozen[ \t\n]+\\|external[ \t]+\"[^\" ]+\"[ \t\n]+\\)?"
  510.   "Special prefix modifiers that can precede a feature definition.")
  511.  
  512. ;; Handles attributes of these forms:
  513. ;;   attr: TYPE
  514. ;;   char: CHARACTER is 'a'
  515. ;;   message: STRING is "Hello, what is your name?"
  516. ;;   flag: BOOLEAN is true ;
  517. (defconst eif-attribute-regexp
  518.   (eif-get-attribute-definition-regexp eif-identifier)
  519.   "Regexp to match to an attribute definition line.")
  520.  
  521. (defconst eif-routine-regexp
  522.   (concat eif-modifier-regexp "\\(" eif-identifier
  523.       "\\|prefix[ \t]+\"[^\" ]+\"\\|infix[ \t]+\"[^\" ]+\"\\)[ \t]*"
  524.       "\\(([^\)]+)[ \t]*\\)?\\(:[ \t\n]*"
  525.       eif-type "[ \t\n]+\\)?is[ \t]*$")
  526.   "Regexp to match to routine definition line.
  527. Ignores obsolete routines and multiple routine definition lists.")
  528. ;;; Should match a multiple feature definition list on a single line
  529. ;;;    (routine-regexp
  530. ;;;      (concat "^[ \t]*\\(\\("
  531. ;;;          eif-identifier "[ \t]*[,]?[ \t]*\\)+\\)"
  532. ;;;          "\\(([^\)]+)[ \t]*\\)?\\(:[ \t]*"
  533. ;;;          eif-type "[ \t]+\\)?is[ \t]*$"))
  534.  
  535. (defun eif-attribute-to-regexp (identifier)
  536.   "Return regexp to match to IDENTIFER attribute definition.
  537. Attribute name is grouping 'eif-feature-name-grpn'."
  538.   (eif-get-attribute-definition-regexp (regexp-quote identifier)))
  539.  
  540. (defun eif-routine-to-regexp (identifier)
  541.   "Return regexp to match to IDENTIFIER's routine definition.
  542. Routine name is grouping 'eif-feature-name-grpn'.  Ignore obsolete routines
  543. and multiple routine definition lists."
  544.   (concat eif-modifier-regexp "\\("
  545.       (regexp-quote identifier) "\\)[ \t]*"
  546.       "\\(([^\)]+)[ \t\n]*\\)?\\(:[ \t\n]*"
  547.       eif-type "[ \t\n]+\\)?is[ \t]*\\(--.*\\)?$"))
  548.  
  549. (defconst eif-modifier-grpn 1
  550.   "Regexp grouping for leading feature modifies, 'frozen' or 'external'.")
  551.  
  552. (defconst eif-feature-name-grpn 2
  553.   "Regexp grouping for feature name from (eif-attribute-to-regexp) or (eif-routine-to-regexp).")
  554.  
  555. (defconst eif-feature-args-grpn 4
  556.   "Regexp grouping for feature arg list for (eif-routine-to-regexp).")
  557.  
  558. (defvar eif-last-class-name nil
  559.   "Last class name used as parameter to 'eif-store-class-info'.  Value is
  560. used by 'eif-insert-class-info'.")
  561.  
  562. (defvar eif-attributes-and-routines nil
  563.   "Class data stored by 'eif-store-class-info' for use by 'eif-insert-class-info'.")
  564.  
  565. (defconst eif-tmp-info-file "/tmp/eif-short"
  566.   "Temporary file used to hold Eiffel class info.")
  567.  
  568. (provide 'eif-calls)
  569.